home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
bbsutil
/
dlx70bbs.zip
/
DLX70SRC.ZIP
/
DLX.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-01-19
|
37KB
|
910 lines
{$debug-}
{$line-}
{$include: 'types.int'}
{$include: 'globals.int'}
{$include: 'ident.int'}
{$include: 'load.int'}
{$include: 'utils.int'}
{$include: 'xmodem.int'}
{$include: 'script5.int'}
{$include: 'database.int'}
{$include: 'dlxutil.int'}
{$include: 'dlxinit.int'}
program DLX (input, output);
{DLX Bulletin Board System V7.0
FREEWARE NOTICE
DLX V7.0 is placed in the public domain by its author, Richard Gillmann.
Anyone who wishes to may run the program, copy it, or modify it for
any purpose, including commercial gain.}
USES types,globals,ident,load,utils,xmodem,script5,database,dlxutil,dlxinit;
const
bs = chr(8);
lf = chr(10);
cr = chr(13);
ctlc_dos = 16#23;
wsize = (number_of_lines+7) div 8;
var
screen_ptr [PUBLIC] : screen_ads_typ;
row0 [PUBLIC], col0 [PUBLIC], lmc0 [PUBLIC] : integer;
stifled [PUBLIC] : boolean;
cancelled [PUBLIC] : boolean;
to_warn [PUBLIC] : integer;
to_kill [PUBLIC] : integer;
bs_local [PUBLIC] : byte;
wrap0 [PUBLIC] : byte;
cesxqq [EXTERN]: word;
doseqq [EXTERN]: word;
tm_warn : para;
{***INTERFACE TO THE COM_PAX2 ASYNCHRONOUS COMMUNICATIONS PACKAGE***}
{$include: 'com_pax2.int'}
{***Interface to the PASASM assembler utilities package***}
{$include: 'pasasm.int'}
{$include: 'newasm.int'}
{***Interface to KBD library***}
{$include: 'kbd.int'}
{***Interface to MS Pascal library***}
function dosxqq(command, parameter: word): byte; EXTERN;
function tics : word; EXTERN;
procedure time(var s : string); EXTERN;
procedure vectin(v : word; procedure i [INTERRUPT]); EXTERN;
{***Interface to Brackenridge's More Handles function***}
{$include: 'extndh.int'}
{***Special for calling file initialize module***}
procedure globals; EXTERN;
procedure endoqq [PUBLIC]; {supercedes stub in Pascal library}
begin
if w.s<>0 and then w^[0].active then restoreh;
if not alls_well then
[writeln('*** LINE:',wx:1,', STATE:',q[wx].state:1);
writeln('*** DEPTH:',macro_depth:1,', INPUT: ',w^[wx].strx)];
end {endoqq};
procedure ctl_break [INTERRUPT];
begin
clean_up;
ret2dos(3);
end {ctl_break};
var
i,j,k,l,m,n,t : integer;
wi,wj : word;
i4 : integer4;
ch : char;
str : lstring(long_line);
p,p2 : para;
oldtop : integer;
ix : 0..long_line;
echo_to_printer : boolean;
local : integer;
cmdline: ads of lstring(255);
doomstime: lstring(5); {planned shutdown time}
label
more_out;
begin
{Initialize}
cmdline.s := cesxqq;
cmdline.r := 16#80;
globals;{pascal file system}
alls_well:=true;
nill.s:=0; nill.r:=0;
w.s:=0;
bavail:=RETYPE(bpara,nill);
init;{setup stuff for pasasm}
{initialize screen pointer}
screen_ptr.s := vidbuf;
screen_ptr.r := 0;
herald;
chkmem;
crit_on;
seed:=tics or 1;
disbpara(newbpara); {force one onto the avail list}
doomstime.len:=0;
w := far_alloc(sizeof(w^));
for i:=1 to ord(cmdline^.len) do
if cmdline^[i]<=':' and then cmdline^[i]>='0' then
[doomstime.len:=doomstime.len+1;
doomstime[doomstime.len]:=cmdline^[i];
if doomstime.len>=UPPER(doomstime) then break];
{Ask sysop which lines to activate}
n:=0;
if number_of_lines>0 then
[writeln('Select serial line(s) to activate:');
writeln];
for i:=number_of_lines downto 1 do begin
write('Activate line ',i:1,'? '); readln(str);
if str<>null and then uc(str[1])='Y' then
[w^[i].onscreen:=true; n:=n+1;
w^[i].baud:=300; w^[i].max_baud:=300;
w^[i].echo:=true]
else if decode(str,wj) then
[w^[i].onscreen:=true; n:=n+1;
w^[i].baud:=wj; w^[i].max_baud:=wj;
w^[i].echo:=false]
else
w^[i].onscreen:=false;
end {for};
w^[0].onscreen:=true; n:=n+1;
w^[0].baud:=9600; w^[0].max_baud:=9600;
w^[0].echo:=true;
if n>10 and then extndh=-1 then
writeln('FILES=?');
config1;
load_em(ch_warn,tm_warn);
config2;
to_warn:=18*timeout-540;
to_kill:=18*timeout;
config_comm;
{main loop}
stifled:=false; cancelled:=false; bs_local:=1;
alls_well:=false;
echo_to_printer:=false;
shutdown_mode:=false;
if n>=(srm1 div 2) then n:=(srm1 div 2)-1; {can only display so many lines}
t:=0;
oldtop:=0;
running:=true;
wx:=0; gstat_line;
vectin(ctlc_dos,ctl_break); {intercept ctrl-break}
{let 'em rip!}
swap_ovl;
for i:=number_of_lines downto 0 do
[w^[i].echo:=true;
if i>0 then
[w^[i].onscreen:=false;
if w^[i].active then
[select_port(i); dtr_on]]];
while running do begin
{time processing -- status lines}
if t<300 then {150 in 5.5}
t:=t+1
else begin
t:=0; allow_break;
mytime[0]:=chr(8); time(mytime);
jt:= (ord(mytime[1])-ord('0'))*10+(ord(mytime[2])-ord('0'));
jt:=jt*60+(ord(mytime[4])-ord('0'))*10+(ord(mytime[5])-ord('0'));
jt:=jt*60+(ord(mytime[7])-ord('0'))*10+(ord(mytime[8])-ord('0'));
if jt<180 then intl_date;
for wx:=number_of_lines downto 0 do
if w^[wx].active and then w^[wx].state=going and then
q[wx].logged_in and then (not q[wx].xover)
then status_line(wx);
wx:=0; gstat_line;
if shutdown_mode then
[if shutdown_time <= (jt div 60) then
[running:=false;
for i:=0 to number_of_lines do
[if w^[i].active and then w^[i].state=going and then
q[i].state<snip then
[w^[i].chat:=-1; q[i].cleanup:='I';
w^[i].node_type:=nt_compute; q[i].state:=cleanup1]
else if i>0 and then q[i].logged_in then
running:=true]]]
else if doomstime.len>=4 and then eq2(mytime,doomstime) then
[doseqq:=0; shut_down(20)];
end {time processing};
{do function keys}
if f_count>0 then
[k:=f_recv;
case k of
59..66 : {F1 thru F8 = show lines in small groups}
[k:=k-58;
if wsize*(k-1)+1<=number_of_lines then
[for i:=number_of_lines downto 1 do w^[i].onscreen:=false;
l:=0; {next available row}
for i:=wsize*k downto wsize*(k-1)+1 do begin
if i>number_of_lines then cycle;
if w^[i].active then w^[i].onscreen:=true;
w^[i].top:=l; w^[i].bot:=w^[i].top+(srm1 div (wsize+1))-2;
w^[i].stat:=w^[i].bot+1; l:=w^[i].stat+1;
scrollup(w^[i].top*256+0,w^[i].bot*256+scm1,nattr,0);
w^[i].row:=w^[i].top;
if w^[i].active and then w^[i].state=going and then
q[i].logged_in and then (not q[i].xover)
then status_line(i);
movesl2(ads w^[i].stat_char^.msg[1],
ads screen_ptr^[w^[i].stat,0].character,screen_cols);
movesl2(ads w^[i].stat_attr^.msg[1],
ads screen_ptr^[w^[i].stat,0].atrb,screen_cols);
end {for};
if w^[0].top>l then
scrollup(l*256+0,(w^[0].top-1)*256+scm1,nattr,0);
if row0=oldtop and then col0=0 then
[w^[0].row:=l; row0:=l; setcp(l,0)];
oldtop:=l; w^[0].top:=l;
w^[0].bot:=screen_rows-3; w^[0].stat:=screen_rows-2;
if row0<w^[0].top then
[row0:=w^[0].top; w^[0].row:=row0;
col0:=0; w^[0].col:=0;
lmc0:=0; w^[0].lmc:=0;
setcp(row0,0)];
scrollup(w^[0].stat*256+0,w^[0].stat*256+scm1,iattr,0);
if w^[0].state=going and then
q[0].logged_in and then (not q[0].xover)
then status_line(0);
movesl2(ads w^[0].stat_char^.msg[1],
ads screen_ptr^[w^[0].stat,0].character,screen_cols);
movesl2(ads w^[0].stat_attr^.msg[1],
ads screen_ptr^[w^[0].stat,0].atrb,screen_cols);
wx:=0; gstat_line]];
67 : {F9 = show all lines}
[m:=0; {number of windows displayed so far}
l:=0; {next available row}
for i:=1 to number_of_lines do
if w^[i].active and then m<n
then [w^[i].onscreen:=true; m:=m+1]
else w^[i].onscreen:=false;
for i:=number_of_lines downto 1 do
if w^[i].active and then w^[i].onscreen then
[w^[i].top:=l; w^[i].bot:=w^[i].top+(srm1 div n)-2;
w^[i].stat:=w^[i].bot